J’installe ma session de travail
Première chose à faire: importer le corpus qui se trouve dans le dossier cours 3. Comme il s’agit d’un csv, nous utilisons la fonction read.csv() Le corpus que nous importons est une collection de blocs d’environ 1000 mots lemmatisés. (notez la présence de lignes commençant par un dièse. Il s’agit d’un commentaire: quand il est utilisé, la ligne n’est pas interprétée par R)
theatre = "moliere_racine.tsv"
# le paramètre `header` permet de signaler que la première ligne contient le nom des colonnes
# le paramètre `sep` permet d'indiquer comment sont marquées les colonnes. La regex `\t` indique que nous utilisons des tabulations (notre fichier est donc en fait un `tsv` et non un vrai `csv`).
# le paramètre fileEncoding permet d'avoir des charactères encodés en UTF8 (si vous avez windows, sans cette option le résultat de l'import peut être problématique)
theatre <- read.csv(theatre, header=TRUE, sep = "\t", quote = '',fill = TRUE, fileEncoding="UTF-8")Je peux jeter un coup d’œil aux données brutes (on ne m’affiche que les première entrées de chaque colonne par commodité)
## 'data.frame': 724 obs. of 8 variables:
## $ auteur : Factor w/ 5 levels "\"MOLIERE, Jean-Baptiste Pocquelin dit (1622-1673) CORNEILLE, Pierre (1606-1684) QUINAULT, Philippe (1635-1688)\"",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ titre : Factor w/ 44 levels "\"ALEXANDRE LE GRAND, TRAGÉDIE.\"",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ date : Factor w/ 24 levels "\"1650\"","\"1655\"",..: 12 12 12 12 12 12 12 12 12 12 ...
## $ genre : Factor w/ 6 levels "\"Comédie galante\"",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ inspiration: Factor w/ 11 levels "\"bible\"","\"féérie\"",..: 10 10 10 10 10 10 10 10 10 10 ...
## $ structure : Factor w/ 5 levels "\"Cinq actes\"",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ type : Factor w/ 3 levels "\"mixte\"","\"prose\"",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ texteLemmat: Factor w/ 724 levels "\" à bande de point de Hongrie appliquer fort proprement sur un drap de couleur de olive avec "| __truncated__,..: 629 169 339 272 673 144 82 333 9 306 ...
Je peux aussi les regarder dans un tableau directement dans RStudio. On remarque que les colonnes ont des noms: “auteur”, “titre”…
Je peux sélectionner juste une colonne (ici “auteur”). Afin de ne pas tout afficher j’utilise la fonction head() pour ne montrer que les premières entrées:
## [1] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
## [2] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
## [3] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
## [4] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
## [5] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
## [6] "MOLIERE, Jean-Baptiste Posquelin dit (1622-1673)"
## 5 Levels: "MOLIERE, Jean-Baptiste Pocquelin dit (1622-1673) CORNEILLE, Pierre (1606-1684) QUINAULT, Philippe (1635-1688)" ...
# Je peux augmenter le nombre de résultat affiché en indiquant le chiffre souhaité de la manière suivante:
#head(theatre$auteur,10)
#Pour les dernières entrées, il existe une fonction `tail`
#tail(theatre$auteur)Toutes les colonnes sont des métadonnées, sauf theatre$texteLemmat qui contient des “morceaux” de pièces de 1000 mots afin de simplifier le travail (nous allons y revenir). Il va falloir transformer le contenu de cette colonne en matrice terme-document (Document Term Matrix), c’est-à-dire créer un tableau avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.
| mot1 | mot2 | mot3 | |
|---|---|---|---|
| Texte1 | 1 | 12 | 9 |
| Texte2 | 1 | 154 | 4 |
C’est le principe d’une approche bag of words, c’est à dire par “sac de mots”: les mots ne sont pas pris dans leur contexte, uniquement par leur fréquence. Cela peut paraître un peu rustre, mais c’est très efficace.
#Je charge deux nouvelles librairies pour le _text mining_ qui me permettent de créer ma matrice
if(!require("tm")){
install.packages("tm")
library("tm")
}## Loading required package: tm
## Loading required package: NLP
## Loading required package: tidytext
# Je transforme mes textes en corpus avec la fonction `corpus()`, un objet de classe `corpus` manipulable dans `R` contenant des données et des métadonnées
#La fonction `VectorSource` transforme chaque document en vecteur
corpus <- Corpus(VectorSource(theatre$texteLemmat), readerControl = list(language = "fr"))
# J'affiche les informations à propos de ce corpus
corpus## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 724
Je peux désormais “utiliser” cet objet:
## [1] 8896
## [1] "\" tout beau charmant nuit daigner vous arrêter il être certain secours que de vous on désirer et je avoir deux mot à vous dire de le part de Jupiter ah ah ce être vous seigneur Mercure qui vous avoir deviner là dans ce posture mon foi je trouver las pour ne pouvoir fournir à_le différent emploi où Jupiter je engager je je être doucement asseoir sur ce nuage pour vous attendre venir vous vous moquer Mercure et vous ne y songer pas seoir il bien à de_le dieu de dire que il être las le dieu être il de fer non mais il falloir sans cesse garder le decorum de le divinité il être de certain mot dont le usage rabaisser ce sublime qualité et que pour leur indignité il être bon que à_le homme on laisser à votre aise vous en parler et vous avoir le beau un chaise roulant où par deux bon cheval en dame nonchalant vous vous faire traîner partout où vous vouloir mais de je ce ne être pas de même et je ne pouvoir vouloir dans mon destin fatal à_le poète assez de mal de leur impertinence extrême de avoir par un injuste loi dont on vouloir maintenir le usage à chaque dieu dans son emploi donner quelque allure en partage et de je laisser à pied je comme un messager de village je qui être comme on savoir en terre et dans le ciel le fameux messager de_le souverain de_le dieu et qui sans rien exagérer par tout le emploi que il je donner avoir besoin plus que personne de avoir de quoi je voiturer que vouloir vous faire à cela le poète faire à leur guise ce ne être pas le seul sottise que on voir faire à ce messieurs là mais contre il toutefois votre âme à tort se irriter et votre aile à_le pied être un don de leur soin oui mais pour aller plus vite être ce que on se en las moins laisser cela seigneur Mercure et savoir ce dont il se agir ce être Jupiter comme je vous le avoir dire qui de votre manteau vouloir le faveur obscur pour certain doux aventure que un nouveau amour il fournir son pratique je croire ne vous être pas nouvelle bien souvent pour le terre il négliger le ciel et vous ne ignorer pas que ce maître de_le dieu aimer à se humaniser pour de_le beauté mortel et savoir cent tour ingénieux pour mettre à bout le plus cruel un œil de Alcmène il avoir sentir le coup et tandis que à_le milieu de_le béotique plaine amphitryon son époux commander à_le troupe thébaine il en avoir prendre le forme et recevoir là-dessous un soulagement à son peine dans le possession de_le plaisir le plus doux le état de_le marier à son feu être propice le hymen ne le avoir joindre que depuis quelque jour et le jeune chaleur de leur tendre amour avoir faire que Jupiter à ce beau artifice se être aviser de avoir recours son stratagème ici se trouver salutaire mais près de maint objet chérir pareil déguisement être pour ne rien faire et ce ne être pas partout un bon moyen de plaire que le figure de un mari je admirer Jupiter et je ne comprendre pas tout le déguisement qui il venir en tête il vouloir goûter par là tout sorte de état et ce être agir en dieu qui ne être pas bête dans quelque rang que il être de_le mortel regarder je le tenir fort misérable se il ne quitter jamais son mine redoutable et que à_le faîte de_le ciel il être toujours guinder il ne être point à mon gré de plus sot méthode que de être emprisonner toujours dans son grandeur et surtout à_le transport de le amoureux ardeur le haut qualité devenir fort incommode Jupiter qui sans doute en plaisir se connaître savoir descendre de_le haut de son gloire suprême et pour entrer dans tout ce que il il plaire il sortir tout à faire de il même et ce ne être plus alors Jupiter qui paraître passer encore de le voir de ce sublime étage dans celui de_le homme venir prendre tout le transport que leur cœur pouvoir fournir et se faire à leur badinage si dans le changement où son humeur le engager à le nature humain il se en vouloir tenir mais de voir Jupiter taureau serpent cygne ou quelque autre chose je ne trouver point cela beau et ne je étonner pas si parfois on en cause laisser dire tout le censeur tel changement avoir leur douceur qui passer leur intelligence ce dieu savoir ce que il faire aussi bien là que ailleurs et dans le mouvement de leur tendre ardeur le bête ne être pas si bête que le on penser revenir à le objet dont il avoir le faveur si par son stratagème il voir son flamme heureux que pouvoir il souhaiter et que être ce que je pouvoir que votre cheval par vous à_le petit pas réduire pour satisfaire à_le vœu de son âme amoureux de un nuit si délicieux faire le plus long \""
Il est absolument fondamental de nettoyer mon corpus de travail. En effet: pas et Pas ne sont pas les mêmes chaînes de caractères (il y a une majuscule dans le second), et peut-être même pas les mêmes mots (adverbe ou substantif?). Je dois donc au moins retirer les majuscules (avec la fonction tolower()), ou même lemmatiser (de préférence avec un outil spécifique, qui n’existe pas dans R).Pour rappel,nous fournissons ici le texte préalablement lemmatisé pour simplifier le travail.
Comme notre objectif est d’avoir une approche thématique et conserver des mots potentiellement porteurs de sens: il faut donc retirer tous les mots les plus fréquents qui n’apportent, comme les les pronoms, les pronoms adverbiaux, les prépositions… Ces mots sont appelés des stopwords et une liste est fournie dans la fonction stopwords()
## [1] "au" "aux" "avec" "ce" "ces" "dans"
## [7] "de" "des" "du" "elle" "en" "et"
## [13] "eux" "il" "je" "la" "le" "leur"
## [19] "lui" "ma" "mais" "me" "même" "mes"
## [25] "moi" "mon" "ne" "nos" "notre" "nous"
## [31] "on" "ou" "par" "pas" "pour" "qu"
## [37] "que" "qui" "sa" "se" "ses" "son"
## [43] "sur" "ta" "te" "tes" "toi" "ton"
## [49] "tu" "un" "une" "vos" "votre" "vous"
## [55] "c" "d" "j" "l" "à" "m"
## [61] "n" "s" "t" "y" "été" "étée"
## [67] "étées" "étés" "étant" "suis" "es" "est"
## [73] "sommes" "êtes" "sont" "serai" "seras" "sera"
## [79] "serons" "serez" "seront" "serais" "serait" "serions"
## [85] "seriez" "seraient" "étais" "était" "étions" "étiez"
## [91] "étaient" "fus" "fut" "fûmes" "fûtes" "furent"
## [97] "sois" "soit" "soyons" "soyez" "soient" "fusse"
## [103] "fusses" "fût" "fussions" "fussiez" "fussent" "ayant"
## [109] "eu" "eue" "eues" "eus" "ai" "as"
## [115] "avons" "avez" "ont" "aurai" "auras" "aura"
## [121] "aurons" "aurez" "auront" "aurais" "aurait" "aurions"
## [127] "auriez" "auraient" "avais" "avait" "avions" "aviez"
## [133] "avaient" "eut" "eûmes" "eûtes" "eurent" "aie"
## [139] "aies" "ait" "ayons" "ayez" "aient" "eusse"
## [145] "eusses" "eût" "eussions" "eussiez" "eussent" "ceci"
## [151] "cela" "celà" "cet" "cette" "ici" "ils"
## [157] "les" "leurs" "quel" "quels" "quelle" "quelles"
## [163] "sans" "soi"
Il existe des listes alternatives en ligne, plus complètes:
#Donner un nom au fichier que je télécharge
mesStops="stopwords-fr.csv"
#indiquer l'URL où se trouve le document à télécharger
stopword_enLigne = "https://raw.githubusercontent.com/stopwords-iso/stopwords-fr/master/stopwords-fr.txt"
#télécharger le fichier et l'enregistrer sous le nom que je viens de lui donner
download.file(stopword_enLigne,mesStops)
#Comme c'est un tableur, je le lis avec la fonction adéquat
stopword_enLigne = read.csv(stopword_enLigne, header=FALSE, stringsAsFactors=FALSE)[,]
#je jette un coup d'œil aux 10 premiers
head(stopword_enLigne,10)## [1] "a" "abord" "absolument" "afin" "ah"
## [6] "ai" "aie" "aient" "aies" "ailleurs"
Je vais utiliser mes listes de stopwords l’une après l’autre pour nettoyer mon corpus. Pour cela j’utilise la fonction tm_map() qui permet de modifier les corpora. Dans ce cas précise j’utilise removeWords avec chacune des deux listes.
## Warning in tm_map.SimpleCorpus(corpus, removeWords, stopwords("french")):
## transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus, removeWords, stopword_enLigne):
## transformation drops documents
#Je jette un coup d'œil à la sixième entrée pour contrôler que tout est en ordre
inspect(corpus_clean[6])## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 1
##
## [1] " de combien de frayeur avoir le âme blesser à_le moindre choc dont entendre voir dans le horreur de pensée jamais consoler de_le coup dont être menacer et de laurier couronne vainqueur part le avoir à ce honneur suprême valoir il ce il en coûter à_le tendresse de cœur pouvoir à moment trembler ce il aimer je ne voir en dont mon feu ne augmenter marquer à mon œil cœur bien enflammer et ce être je le avouer chose charmant de trouver de amour dans objet aimer mais je le oser dire scrupule je gêne à_le tendre sentiment je faire voir et le bien goûter mon amour cher Alcmène vouloir ne voir entrer de devoir à ardeur à mon je devoir le faveur je recevoir de et le qualité je avoir de époux ne être point ce je le donner ce être de ce nom pourtant le ardeur je brûler le droit de paraître à_le jour et je ne comprendre à ce nouveau scrupule dont embarrasser amour ah ce je avoir de ardeur et de tendresse passer aussi celui de époux et ne savoir dans de_le moment doux en être le délicatesse ne concevoir point cœur bien amoureux cent petit égard attacher avec étude et faire inquiétude de le manière de être heureux en je beau et charmant Alcmène voir mari voir amant mais le amant je toucher à franchement et je sens de le mari le gêne ce amant de vœu jaloux à_le dernier point souhaite à il cœur abandonner et passion ne vouloir point de ce le mari il donner il vouloir de source obtenir ardeur et ne vouloir de_le nœud de le hyménée de fâcheux devoir faire agir le coeur et le jour de_le cher faveur le douceur être empoisonner dans le scrupule enfin dont il être combattre il vouloir satisfaire à délicatesse le séparer de avec ce le blesser le mari ne être vertu et de cœur de bonté revêtir le amant avoir le amour et le tendresse amphitryon en vérité moquer de ce langage et je avoir peur ne croire sage de être écouter ce discours être raisonnable Alcmène ne penser mais long séjour je coupable et de_le à_le port le moment être presser adieu de mon devoir le étrange barbarie temps je arracher de mais beau Alcmène à_le moins voir le époux songer à le amant je prier je ne séparer point ce unir le dieu et le époux et le amant je être fort précieux ô ciel de aimable caresse de époux ardemment chérir et mon traître de mari être loin de ce tendresse le nuit il je falloir avertir ne avoir à plier voile et effacer le étoile le soleil de lit pouvoir maintenant sortir ce être ainsi le je quitte et comment donc ne vouloir de mon devoir je je acquitter et de amphitryon je aller le mais avec ce brusquerie traître de je séparer le beau de fâcherie nous avoir de temps ensemble à demeurer mais partir ainsi de façon brutal je dire mot de douceur régaler diantre vouloir mon esprit aller chercher de_le faribole an de mariage épuiser le et depuis long temps nous nous être dire regarder traître amphitryon voir combien Alcmène il étaler de flamme et rougir là-dessus de_le de passion témoigne femme hé mon Dieu cléantir il être encore amant il être certain âge passer et ce leur seoir bien dans ce commencement en nous vieux marier avoir mauvais grâce il nous faire beau voir attacher face à face à pousser le beau sentiment être je hors de état perfide de espérer cœur auprès de je soupirer non je ne avoir garde de le dire mais je être barbon oser soupirer et je faire crever de rire mérite pendard ce insigne bonheur de voir épouse femme de honneur mon Dieu ne être honnête ce grand honneur ne je valoir ne être point femme de bien et je rompre moins le tête comment de "
Malheureusement cette commande tm_map() fonctionne mal, et il est préférable de nettoyer le texte “à l’ancienne”, en créant sa propore fonction.
#Je recharge mon corpus
corpus_clean <- tm_map(corpus_clean, PlainTextDocument)
#je crée une fonction a deux paramètres: le corpus d'entrée et la liste des stopwords.
removeStopWords <- function(corpus_a_nettoyer, stopwords_a_retirer){
# je fais une boucle pour retirer chaque mot de `stopwords_a_retirer`
for (word in stopwords_a_retirer){
#J'utilise une fonction anonyme (_snonymous function_) à un paramètre qui utilise la fonction `gsub` qui remplace le mot de `stopwords_a_retirer` par rien.
removeWord <- function(x) gsub(paste("(^|\\s)(",word,") ", sep="")," ",x)
#on retire le mot
corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWord)
}
#Je renvoie le résultat
return(corpus_a_nettoyer)
}
#Je passe mon `corpus_clean` comme `corpus_a_nettoyer` et mes `stopword_enLigne` comme `stopwords_a_retirer`.
corpus_clean <- removeStopWords(corpus_clean, stopword_enLigne)S’il reste des mots qui ne me plaisent pas, je peux continuer de les retirer en les mettant dans un vecteur
stopWords <- c( "à_le", "de_le", "-être", "faire", "falloir", "savoir", "pouvoir", "devoir", "devoir", "voir", "vouloir")
corpus_clean <- tm_map(corpus_clean, removeWords, stopWords)## Warning in tm_map.SimpleCorpus(corpus_clean, removeWords, stopWords):
## transformation drops documents
## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 1
##
## [1] " frayeur âme blesser moindre choc entendre horreur pensée jamais consoler coup menacer laurier couronne vainqueur part honneur suprême valoir coûter tendresse cœur moment trembler aimer feu augmenter marquer œil cœur enflammer avouer chose charmant trouver amour objet aimer oser scrupule gêne tendre sentiment goûter amour Alcmène entrer ardeur faveur recevoir qualité époux point donner nom pourtant ardeur brûler droit paraître jour comprendre scrupule embarrasser amour ardeur tendresse passer époux moment doux délicatesse concevoir point cœur amoureux petit égard attacher étude inquiétude manière heureux charmant Alcmène mari amant amant toucher franchement sens mari gêne amant vœu jaloux point souhaite cœur abandonner passion point mari donner source obtenir ardeur nœud hyménée fâcheux agir coeur jour faveur douceur empoisonner scrupule combattre satisfaire délicatesse séparer blesser mari vertu cœur bonté revêtir amant amour tendresse amphitryon vérité moquer langage peur croire sage écouter discours raisonnable Alcmène penser long séjour coupable port moment presser adieu étrange barbarie temps arracher Alcmène époux songer amant prier séparer point unir dieu époux amant fort précieux ciel aimable caresse époux ardemment chérir traître mari loin tendresse nuit avertir plier voile effacer étoile soleil lit sortir quitte acquitter amphitryon aller brusquerie traître séparer fâcherie temps ensemble demeurer partir brutal douceur régaler diantre esprit aller chercher faribole an mariage épuiser long temps regarder traître amphitryon Alcmène étaler flamme rougir là-dessus passion témoigne femme Dieu cléantir amant âge passer seoir commencement vieux marier mauvais grâce attacher face face pousser sentiment perfide espérer cœur auprès soupirer garde barbon oser soupirer crever rire mérite pendard insigne bonheur épouse femme honneur Dieu honnête grand honneur valoir point femme rompre tête "
Je fais de nouveau une matrice “terme/document” (DTM, Document-term matrix). On se rappelle qu’il s’agit de créer une matrice (un tableau) avec une colonne pour chaque mot de mon corpus, et un rang par texte de mon corpus.
| mot1 | mot2 | mot3 | |
|---|---|---|---|
| Texte1 | 1 | 12 | 9 |
| Texte2 | 1 | 154 | 4 |
Je peux désormais observer la fréquence des mots: je retrouve la loi de Zipf dans la distribution de mes données
freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Comme je vais dessiner un graph, j'ai besoin d'une nouvelle librairie: `ggplot2`
if (!require("ggplot2")){
install.packages("ggplot2")
library("ggplot2")
}## Loading required package: ggplot2
##
## Attaching package: 'ggplot2'
## The following object is masked from 'package:NLP':
##
## annotate
Je peux compter les mots avec des fréquences faibles, par exemple avec moins de 100 occurrences
#Je retire tous les mots qui apparaissent entre 0 et 400 fois (on peut remplacer 400 par 100, ou même 10 si le corpus est trop gros)
motsPeuFrequents <- findFreqTerms(dtm, 0, 400)
#Si vous êts sur windows, décommentez la ligne suivante
#Encoding(motsPeuFrequents)<-"latin-1"
length(motsPeuFrequents)## [1] 8550
## [1] "admirer" "agir" "aile" "aise" "alcmène"
## [6] "allure" "amoureux" "amphitryon" "ardeur" "arrêter"
## [11] "artifice" "asseoir" "aventure" "aviser" "badinage"
## [16] "beauté" "besoin" "bout" "béotique" "bête"
## [21] "cause" "censeur" "cesse" "chaise" "chaleur"
## [26] "changement" "charmant" "cheval" "chérir" "commander"
## [31] "comprendre" "cruel" "cygne" "daigner" "dame"
## [36] "decorum" "descendre" "destin" "devenir" "deviner"
## [41] "divinité" "don" "doucement" "douceur" "doute"
## [46] "doux" "déguisement" "délicieux" "désirer" "emploi"
Je peux aussi compter et afficher les mots les plus fréquents, par exemple avec plus de 400 occurrences
motsTresFrequents <- findFreqTerms(dtm, 401, Inf)
#Si vous êts sur windows, décommentez la ligne suivante
#Encoding(motsTresFrequents)<-"latin-1"
length(motsTresFrequents)## [1] 65
## [1] "aimer" "aller" "amour" "attendre" "chose"
## [6] "ciel" "connaître" "coup" "croire" "cœur"
## [11] "dieu" "donner" "foi" "fort" "gloire"
## [16] "homme" "jamais" "jour" "mal" "mettre"
## [21] "oui" "passer" "penser" "plaire" "point"
## [26] "prendre" "seigneur" "soin" "sortir" "trouver"
## [31] "venir" "âme" "œil" "affaire" "esprit"
## [36] "grand" "honneur" "madame" "monde" "monsieur"
## [41] "mort" "nom" "porter" "raison" "temps"
## [46] "chercher" "entendre" "lieu" "main" "perdre"
Je fais un très grand ménage, avec une fonction que je crée pour retirer les mots les moins fréquents:
#Je crée une fonction `grandMenage`
grandMenage <- function(corpus_a_nettoyer, mots_peu_importants){
#Afin de simplifier le travail (de mon ordinateur), je vais rassembler les mots à retirer en groupe 500 tokens, que je vais traiter séparément.
chunk <- 500
#Je compte le nombre de mots à retirer
n <- length(mots_peu_importants)
#Je compte les groupes de 500 (ici 17.05), j'arrondis au plus petit entier supérieur (ici 18)
r <- rep(1:ceiling(n/chunk),each=chunk)[1:n]
#Je constitue mes lots sur la base du décompte précédemment mentionné
d <- split(mots_peu_importants,r)
#Je fais une boucle: pour retirer les mots du corpus, morceau par morceau
for (i in 1:length(d)) {
corpus_a_nettoyer <- tm_map(corpus_a_nettoyer, removeWords, c(paste(d[[i]])))
}
#Je renvoie un résultat
return(corpus_a_nettoyer)
}
# J'utilise ma fonction avec `corpus_clean` comme ` corpus_a_nettoyer` et `motsPeuFrequents` comme `mots_peu_importants`
corpus_clean <- grandMenage(corpus_clean, motsPeuFrequents)## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
## Warning in tm_map.SimpleCorpus(corpus_a_nettoyer, removeWords,
## c(paste(d[[i]]))): transformation drops documents
Je redéfinis ma matrice à partir de mon nouveau corpus
dtm <- DocumentTermMatrix(corpus_clean)
rownames(dtm) <- theatre$genre
freq <- as.data.frame(colSums(as.matrix(dtm)))
colnames(freq) <- c("frequence")
#Je fais un petit graph
ggplot(freq, aes(x=frequence)) + geom_density()Je nettoye un peu ma DTM pour éliminer les rangs vides
Remarque préliminaire: le topic modeling requiert des (très) grands corpus, si possible en centaines de documents. Pas de panique cependant: une manière de les obtenir est de diviser chaque textes en plusieurs documents qui forment une unité sémantique. Par exemple le chapitre, la scène, le paragraphe, ou bien (comme c’est le cas pour notre exercice) de 1000 mots.
Un thème (topic) est un clusters de mots, i.e. une récurrence de co-occurrence.
100% center
Source: Wikisource
Le principe du topic modeling est proche de celui de surligner un texte avec plusieurs couleurs: une pour chaque sujet, thème ou topic.
100% center
Une telle image soulève deux questions sur lesquelles nous reviendront plus tard: * un article peut-il contenir plusieurs sujets? * un mot peut-il n’appartenir qu’à un seul sujet?
Afin de reconnaître ces sujets, on va recourir à une allocation de Dirichlet latente ( Latent Dirichlet allocation, LDA). * C’est une approche non supervisée, c’est-à-dire qu’elle ne nécessite pas d’annotation préalable de données. * Il nous faut définir à l’avance un nombre de sujets/thèmes (infra la variable k)
Le LDA est modèle génératif probabiliste permettant d’expliquer des ensembles d’observations, par le moyen de groupes non observés, eux-mêmes définis par des similarités de données.
150% center
Source: wikipedia
Dans ce graph: * M est le nombre de documents (corpus) * N est le nombre de mots (document) * W est un mot observé
La partie latente (cachée): * Z est un topic attribué à un w * θ est le mélange des topics à l’échelle du document
Deux paramètres pour la distribution * α est la distribution par document. Si sa valeur est élevée, le document tend à contenir plusieurs topics, si la valeur est faible le nombre de topics est limité * β est la distribution par topic. Si sa valeur est élevée, un même mot se retrouve dans plusieurs topics (qui se ressemblent donc), si la valeur est faible les similarités entre les topics est faible
150% center
Source: wikipedia
Le modèle va classer aléatoirement tous les mots en n sujets, et tenter d’affiner cette répartition de manière itérative en observant les contextes:
#J'installe une nouvelle librairie pour le _topic modeling_
if(!require("topicmodels")){
install.packages("topicmodels")
library("topicmodels")
}## Loading required package: topicmodels
#Je vais partir sur une classification en deux _topics_
k = 2
lda_2 <- LDA(dtm_clean, k= k, control = list(seed = 1234))
##Je tente avec trois, pour voir…
lda_3 <- LDA(dtm_clean, k= k+1, control = list(alpha = 0.1))Le résultat produit est une matrice avec pour chaque mot la probabilité qu’il appartienne à un des différents topics. On donne un score β, qui est celui présenté infra.
## # A tibble: 848 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 aimer 0.0200
## 2 2 aimer 0.0202
## 3 1 alcmène 0.000349
## 4 2 alcmène 0.00106
## 5 1 aller 0.0303
## 6 2 aller 0.0571
## 7 1 amour 0.0130
## 8 2 amour 0.0302
## 9 1 attendre 0.00547
## 10 2 attendre 0.0151
## # … with 838 more rows
Les paramètres de Gibbs permettent une sophistication du système précédent. C’est une probabilité conditionnelle qui s’appuie, pour calculer le β d’un mot, sur le β des mots voisins. Pour ce faire nous devons déterminer: 1. À quel point un document aime un topic 2. À quel pount un topic aime un mot
Un document:
| Voiture | Autoroute | Musique | Vélo | Vacances |
|---|---|---|---|---|
| 1 | ?? | 2 | 1 | 3 |
Sachant que le décompte est le suivant
| topic 1 | topic 2 | topic 3 | |
|---|---|---|---|
| Voiture | 34 | 49 | 75 |
| Autoroute | 150 | 50 | 70 |
| Musique | 34 | 4 | 170 |
| Vélo | 543 | 2 | 150 |
| Vacances | 23 | 70 | 563 |
Le topic 1 est le plus représenté dans le document, et Autoroute est déjà surreprésenté dans le décompte, donc on update le tout
| Voiture | Autoroute | Musique | Vélo | Vacances |
|---|---|---|---|---|
| 1 | 1 | 2 | 1 | 3 |
| topic 1 | topic 2 | topic 3 | |
|---|---|---|---|
| Voiture | 34 | 49 | 75 |
| Autoroute | 151 | 50 | 70 |
| Musique | 34 | 4 | 170 |
| Vélo | 543 | 2 | 150 |
| Vacances | 23 | 70 | 563 |
## Set parameters for Gibbs sampling
#Le modèle va tourner 2000 fois avant de commencer à enregistrer les résultats
burnin <- 2000
#Après cela il va encore tourner 2000 fois
iter <- 2000
# Il ne va enregistrer le résultat que toutes les 500 itérations
thin <- 500
#seed et nstart pour la reproductibilité
SEED=c(1, 2, 3, 4, 5)
seed <-SEED
nstart <- 5
#Seul meilleur modèle est utilisé
best <- TRUE
#2 topics
lda_gibbs_2 <- LDA(dtm_clean, k, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))
#3 topics
lda_gibbs_3 <- LDA(dtm_clean, k+1, method="Gibbs", control=list(nstart=nstart, seed=seed, best=best, burnin=burnin, iter=iter, thin=thin))Je peux désormais voir les premiers résultats pour chacun des modèles. Il s’agit de de mots dont la fréquence d’utilisation est corrélée
## [1] "LDA 2"
## Topic 1 Topic 2
## 1 venir point
## 2 monsieur aller
## 3 point cœur
## 4 prendre amour
## 5 aller donner
## 6 madame monsieur
## 7 homme croire
## 8 jamais chose
## 9 œil mettre
## 10 père oui
## [1] "LDA 3"
## Topic 1 Topic 2 Topic 3
## 1 dieu monsieur cœur
## 2 roi point point
## 3 fils aller madame
## 4 sang venir aller
## 5 père chose seigneur
## 6 ciel oui amour
## 7 aller donner œil
## 8 main prendre aimer
## 9 jour homme venir
## 10 seigneur fort croire
## [1] "LDA GIBBS 2"
## Topic 1 Topic 2
## 1 point cœur
## 2 monsieur madame
## 3 aller amour
## 4 venir œil
## 5 donner aimer
## 6 prendre seigneur
## 7 oui dieu
## 8 chose ciel
## 9 trouver jour
## 10 homme croire
## [1] "LDA GIBBS 3"
## Topic 1 Topic 2 Topic 3
## 1 point monsieur seigneur
## 2 cœur aller dieu
## 3 madame oui œil
## 4 croire donner fils
## 5 venir chose aller
## 6 aimer prendre main
## 7 amour homme jour
## 8 jamais trouver roi
## 9 âme fort père
## 10 grand venir attendre
Nous allons utiliser lda_gibbs_2 et construire une matrice avec les β des tokens (pour les ɣ, et donc des probabilités par document, on aurait mis matrix = "gamma"). Chaque token est répété deux fois, avec une probabilité pour chaque topic:
## # A tibble: 848 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 aimer 0.00000371
## 2 2 aimer 0.0400
## 3 1 alcmène 0.000598
## 4 2 alcmène 0.000811
## 5 1 aller 0.0650
## 6 2 aller 0.0226
## 7 1 amour 0.00000371
## 8 2 amour 0.0429
## 9 1 attendre 0.00000371
## 10 2 attendre 0.0205
## # … with 838 more rows
#Je vais encore solliciter une nouvelle librairie
if (!require("dplyr")){
install.packages("dplyr")
library("dplyr")
}## Loading required package: dplyr
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
#Je récupère mes mots
top_terms <- topics %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)
#Je fais un graph
top_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta, fill = factor(topic))) + geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip() +
scale_x_reordered()Je vais désormais associer chaque mot à l’un des 5 genres possibles, pour déterminer auquel mes tokens sont rattachés, et découvrir (potentiellement quel genre se cacher derrière quel topic
## Loading required package: reshape2
df <- melt(as.matrix(dtm_clean))
df <- df[df$Terms %in% findFreqTerms(dtm_clean, lowfreq = 800), ]
ggplot(df, aes(as.factor(Docs), Terms, fill=log(value))) +
geom_tile() +
xlab("Genres") +
scale_fill_continuous(low="#FEE6CE", high="#E6550D") +
theme(axis.text.x = element_text(angle=90, hjust=1))tt <- posterior(lda_gibbs_2)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])
colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) +
geom_tile() +
theme(text = element_text(size=35))tt <- posterior(lda_gibbs_3)$terms
melted = melt(tt[,findFreqTerms(dtm_clean, 1000,10000)])
colnames(melted) <- c("Topics", "Terms", "value")
melted$Topics <- as.factor(melted$Topics)
ggplot(data = melted, aes(x=Topics, y=Terms, fill=value)) +
geom_tile() +
theme(text = element_text(size=35))On peut aussi observer le score gamma, c’est-à-dire la probabilté qu’un document contienne un sujet:
DocumentTopicProbabilities <- as.data.frame(lda_gibbs_2@gamma)
rownames(DocumentTopicProbabilities) <- rownames(corpus_clean)
head(DocumentTopicProbabilities)## V1 V2
## 1 0.4786325 0.5213675
## 2 0.5083333 0.4916667
## 3 0.5433071 0.4566929
## 4 0.5619835 0.4380165
## 5 0.5357143 0.4642857
## 6 0.4545455 0.5454545
Nous allons désormais faire des word clouds. Pour cela appelons (installons?) les libraries suivantes:
## Loading required package: wordcloud
## Loading required package: RColorBrewer
if (!require("RColorBrewer")){
install.packages("RColorBrewer")
library("RColorBrewer")
}
if (!require("wordcloud2")){
install.packages("wordcloud2")
library("wordcloud2")
}## Loading required package: wordcloud2
je récupère les mots et je les associe à leur 𝛃
## colnames.tm.
## 1 aimer
## 2 alcmène
## 3 aller
## 4 amour
## 5 attendre
## 6 chose
Je produis une visualisation par topic
for(topic in seq(k)){
data$topic <-tm[topic,]
#text(x=0.5, y=1, paste("V",topic, sep=""),cex=0.6)
wordcloud(
words = data$colnames.tm.,
freq = data$topic,
#sous ce seuil, les mots ne seront pas affichés
min.freq=0.0002,
#nombre maximum de mots à afficher
max.words=30,
#Si faux, en ordre croissant
random.order=FALSE,
#% de mots à 90°
rot.per=.35,
#taille du graph
scale=c(10,10),
#couleurs
colors = brewer.pal(5, "Dark2")
# il est possible de rentrer directement les couleurs qui nous intéressent
#c("red", "blue", "yellow", "chartreuse", "cornflowerblue", "darkorange")
)
}Finissons avec un peu de mauvais goût, grâce au package wordcloud2
Les données d’entraînement ont été créées par JB Camps (ENC). Des morceaux de ce script (notamment pour le nettoyage des données) proviennent d’un cours de Mattia Egloff (UniL).